home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjag86.arc / MANDEL.PAS < prev    next >
Pascal/Delphi Source File  |  1986-05-06  |  5KB  |  139 lines
  1. Program Mandelbrot;
  2.  
  3. type
  4.    reg       = array[0..11] of byte;
  5. const
  6.    xmin      = -2.0;
  7.    xrange    =  2.6;
  8.    ymin      = -1.3;
  9.    yrange    =  2.6;
  10.    crt_index_reg   =$03D4; { Port # of Index register of 6845       }
  11.    crt_data_reg    =$03D5; { Port # of Input register of 6845       }
  12.    mode_select_reg =$03D8; { Port # of video mode select register   }
  13.    color_select_reg=$03D9; { Port # of video color select register  }
  14. var
  15.    c,j,k,n      : integer;
  16.    x,y,dx,dy    : real;
  17.    crt_mode_set 
  18.          : byte absolute $0000:$0465; { Used by BIOS to maintain    }
  19.    crt_palette  
  20.          : byte absolute $0000:$0466; { values of mode & color regs }
  21.    screen       : array[1..16384] of byte absolute $B800:$0000;
  22. label
  23.    quit;
  24.  
  25. {-------- CLEARS SCREEN --------------------------------------------}
  26.  
  27. Procedure ClearScreen;
  28. begin
  29.    port[mode_select_reg] := 0; { Disables video to prevent snow     }
  30.    FillChar(screen,16384,0);   { Fills screen with chr 0 attribute 0}
  31.    port[mode_select_reg] := 9; { Enables video to see screen        }
  32. end;
  33.  
  34. {-------- SET 6845 CRT CONTROLLER TO LO-RES MODE -------------------}
  35.  
  36. Procedure LoRes;
  37. const
  38.    regdata  :  reg = (113,80,90,10,127,6,100,112,2,1,32,0);
  39. var
  40.    i        :  byte;
  41. begin
  42.    crt_mode_set := 0;
  43.    crt_palette  := 0;
  44.    port[color_select_reg] := 0;
  45.    for i := 0 to 11 do
  46.    begin
  47.       port[crt_index_reg] := i;
  48.       port[crt_data_reg]  := regdata[i];
  49.    end;
  50.    ClearScreen;
  51.    crt_mode_set := 9;
  52. end;
  53.  
  54. {-------- SET 6845 CRT CONTROLLER TO 80x25 TEXT SCREEN -------------}
  55.  
  56. Procedure TextScreen;
  57. const
  58.     regdata  :  reg = (113,80,90,10,31,6,25,28,2,7,6,7);
  59. var
  60.    i         :  byte;
  61. begin
  62.    for i := 0 to 11 do
  63.    begin
  64.       port[crt_index_reg] := i;
  65.       port[crt_data_reg]  := regdata[i];
  66.    end;
  67.    crt_mode_set := 41;
  68.    ClrScr;
  69. end;
  70.  
  71. {-------- PLOTS POINT AT (x,y) in COLOR c --------------------------}
  72.  
  73. Procedure Point(x,y,c:integer);
  74. begin
  75.    inline($B8/$00/$02/      { MOV AX,0200H   0200 -> AX      }
  76.           $30/$FF/          { XOR BH,BH      0 -> BH         }
  77.           $8A/$56/$08/      { MOV DL,[BP+8]  x -> DL         }
  78.           $D0/$EA/          { SHR DL,1       x/2->DL,rem->CF }
  79.           $8A/$76/$06/      { MOV DH,[BP+6]  y -> DH         }
  80.           $CD/$10/          { INT 10H        locates cursor  }
  81.           $B8/$00/$08/      { MOV AX,0800H   0800 -> AX      }
  82.           $CD/$10/          { INT 10H        read attribute  }
  83.           $8A/$5E/$04/      { MOV BL,[BP+4]  c -> BL         }
  84.           $73/$05/          { JNC +5         x even => CF=0  }
  85.           $25/$00/$F0/      { AND AH,F0H     discard old fg  }
  86.           $EB/$0B/          { JMP +11        Jmp to col asmb }
  87.           $D0/$E3/          { SHL BL,1       x even so       }
  88.           $D0/$E3/          { SHL BL,1        c is bg        }
  89.           $D0/$E3/          { SHL BL,1         shift bg      }
  90.           $D0/$E3/          { SHL BL,1          left 4 bits  }
  91.           $25/$00/$0F/      { AND AH,0FH     discard old bg  }
  92.           $00/$E3/          { ADD BL,AH      assemble color  }
  93.           $B8/$DE/$09/      { MOV AX,09DE    chr ▐ to AH     }
  94.           $B9/$01/$00/      { MOV CX,01      one to write    }
  95.           $CD/$10);         { INT 10H        write chr, attr }
  96. end;
  97.  
  98. {-------- DETERMINE NUMBER OF ITERATIONS AT (x,y) ------------------}
  99.  
  100. Function Iterate(x,y:real):integer;
  101. var
  102.    n          : integer;
  103.    i,r,zi,zr  : real;
  104. begin
  105.    zr := x; zi := y;                      { Initialize z            }
  106.    n := 64;                               { Iteration counter       }
  107.    repeat
  108.       n := n-1;                           { Decrement counter       }
  109.       r := zr*zr - zi*zi + x;             { Real part of next z     }
  110.       i := 2*zr*zi + y;                   { Imaginary part of next z}
  111.       zr := r; zi := i;                   { Update z                }
  112.    until (zr*zr + zi*zi > 4) or (n = 0);  
  113.                                    { Modulus² > 4 or 64 iterations  }
  114.    Iterate := n;                   { Return 64 - # of iterations    }
  115. end;
  116.  
  117. {-------- MAIN PROGRAM BEGINS --------------------------------------}
  118.  
  119. begin
  120.    LoRes;                             { Switch to LoRes mode         }
  121.    dx := xrange/159; dy := yrange/99; { Scale world to screen        }
  122.    y := ymin + yrange;                { Maximum y to top of screen   }
  123.    for j := 0 to 99 do                { 100 rows on LoRes screen     }
  124.    begin
  125.     x := xmin;                      { Minimum x to left of screen    }
  126.     for k := 0 to 159 do            { 160 columns on LoRes screen    }
  127.      begin
  128.       n := Iterate(x,y);            { Determine number of iterations }
  129.       c := n div 8;                 { Determine color number 0..7    }
  130.       if n mod 8 > 3 then c := c+8; { If remainder = 4..7 then bright}
  131.       Point(k,j,c);                 { Plot point on screen           }
  132.       if keypressed then goto quit; { Press any key to interrupt/quit}
  133.       x := x + dx;                  { Update x coordinate of point   }
  134.      end;                           { Loop until finished with row   }
  135.      y := y - dy;                   { Update y coordinate of point   }
  136.    end;                             { Loop until finished with screen}
  137. quit:   repeat until keypressed;    { Hold picture until key pressed }
  138.    TextScreen;                      { Restore normal text screen     }
  139. end.